home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programmierung
/
Power-Programmierung (Tewi)(1994).iso
/
magazine
/
nan_news
/
vol3
/
no5
/
twomenu2.prg
< prev
next >
Wrap
Text File
|
1989-03-01
|
8KB
|
322 lines
* Program: TwoMenu2.prg
* Author: Rick Spence
* Version: Clipper Summer '87
* Note(s): See Function Definition below.
*
* Copyright (c) 1989 Nantucket Corporation.
* Sample call for twodmenu() function.
* (Alternative Implementation.)
CLEAR
t = 10
l = 10
b = 20
r = 45
* We make this public as we redimension it if we insert an
* element. It is then clearer that you need to explicitly
* RELEASE it.
PUBLIC sel_list[7]
sel_list[1] = "Brauer, Doris"
sel_list[2] = "Brown, Laurell"
sel_list[3] = "Cummings-Knight, Philip"
sel_list[4] = "Gruen, Keith"
sel_list[5] = "Humbs, Ingrid"
sel_list[6] = "Muller, Dietmar"
sel_list[7] = "Spence, Rick"
PRIVATE commands[5]
commands[1] = "Select"
commands[2] = "Delete"
commands[3] = "Insert"
commands[4] = "Change"
commands[5] = "Exit"
PRIVATE funcs[5]
funcs[1] = "sel_func"
funcs[2] = "del_func"
funcs[3] = "ins_func"
funcs[4] = "change_func"
funcs[5] = "ex_func"
com_sel = 1
sel_no = twodmenu(t, l, b, r, sel_list, commands, @com_sel, funcs)
RELEASE sel_list
* Alternative Function Definition:
*
* NUMERIC twodmenu(t, l, b, r, sel_list, commands,;
* @com_selected, funcs)
*
* NUMERIC t, l, b, r - The box's coordinates.
*
* CHARACTER sel_list[] - The list of items from which to choose.
*
* CHARACTER commands[] - The list of commands.
*
* NUMERIC @com_selected - The number of the selected command.
* This must be passed by reference.
*
* CHARACTER funcs - Function to be called, corresponding to
* command elements.
*
* Function returns one of:
*
* 0 - Exit, with twodmenu() returning
* current values.
*
* 1 - Abort exit, with twodmenu()
* returning 0.
*
* 2 - Redisplay, which forces twodmenu()
* to redisplay the list. This is
* useful if an item has been deleted
* or inserted.
*
* The function is passed the currently
* selected item as a parameter.
*
* The function returns the element number of the sel_list array
* that the user chose. This is zero if the user escaped from the
* function with the escape key.
FUNCTION twodmenu
PARAM t, l, b, r, sel_list, commands, com_selected, funcs
PRIVATE selection, win_save, com_cols[LEN(commands)], i, tot_width
PRIVATE spaces_between, num_commands, cur_pos, start_chars
PRIVATE ac_mode, ac_rel, AC_REDRAW, AC_FINISHED
* Initialize required memory variable constants.
init_consts()
selection = 1
num_commands = LEN(commands)
win_save = SAVESCREEN(t, l, b, r)
* Draw interleaved boxes.
@ t, l TO b, r
@ b - 2, l, b, r BOX CHR(195) + CHR(196) + CHR(180) + CHR(179) + ;
CHR(217) + CHR(196) + CHR(192) + CHR(179)
* Figure out spacing for commands.
tot_width = 0
FOR i = 1 TO num_commands
tot_width = tot_width + LEN(commands[i])
NEXT
spaces_between = INT(((r - l - 1) - tot_width)/(num_commands + 1))
* Draw commands and build first characters string.
cur_pos = l + 1 + spaces_between
start_chars = ""
FOR i = 1 TO num_commands
com_cols[i] = cur_pos
@ b - 1, cur_pos SAY commands[i]
cur_pos = cur_pos + LEN(commands[i]) + spaces_between
start_chars = start_chars + UPPER(SUBSTR(commands[i], 1, 1))
NEXT
highlight_current()
ac_redraw = 0
ac_finished = 1
ac_mode = ac_redraw
ac_rel = 0
selection = 1
DO WHILE ac_mode = ac_redraw
ac_mode = ac_finished
* Clear the list area.
SCROLL(t + 1, l + 1, b - 3, r - 1, 0)
selection = ACHOICE(t + 1, l + 1, b - 3, r - 1, sel_list, ;
.T., "ac_func", selection, ac_rel)
ENDDO
RESTSCREEN(t, l, b, r, win_save)
RETURN selection
* ACHOICE() user function.
FUNCTION ac_func
PARAMETER mode, cur_elem, rel_pos
PRIVATE ret_val, lkey, fname, f_ret_val
ac_rel = rel_pos
ret_val = ac_continue
IF mode = ac_excep
lkey = LASTKEY()
DO CASE
CASE lkey = esc
ret_val = ac_abort
CASE lkey = enter .OR. UPPER(CHR(lkey)) $ start_chars
IF lkey != enter
dehighlight_current()
com_selected = at(UPPER(CHR(lkey)), start_chars)
highlight_current()
ENDIF
IF type("funcs[com_selected]") != "U"
* Call func.
fname = funcs[com_selected] + "(cur_elem)"
f_ret_val = &fname
DO CASE
CASE f_ret_val = 0
ret_val = ac_select
CASE f_ret_val = 1
ret_val = ac_abort
CASE f_ret_val = 2 && Redraw.
* Set global to force reentry
ac_mode = ac_redraw
ret_val = ac_select
CASE f_ret_val = 3
ret_val = ac_continue
OTHERWISE
ret_val = ac_select
ENDCASE
ELSE
ret_val = ac_select
ENDIF
CASE lkey = left_arrow
dehighlight_current()
IF com_selected = 1
com_selected = num_commands
ELSE
com_selected = com_selected - 1
ENDIF
highlight_current()
ret_val = ac_continue
CASE lkey = right_arrow
dehighlight_current()
IF com_selected = num_commands
com_selected = 1
ELSE
com_selected = com_selected + 1
ENDIF
highlight_current()
ret_val = ac_continue
ENDCASE
ENDIF
RETURN ret_val
FUNCTION highlight_current
* Highlight current command.
@ b - 1, com_cols[com_selected] GET commands[com_selected]
CLEAR GETS
RETURN void
FUNCTION dehighlight_current
* Highlight current command.
@ b - 1, com_cols[com_selected] SAY commands[com_selected]
RETURN void
FUNCTION init_consts
PUBLIC left_arrow, right_arrow, void, esc, enter
PUBLIC ac_continue, ac_select, ac_abort, ac_excep
left_arrow = 19
right_arrow = 4
void = .T.
esc = 27
enter = 13
ac_continue = 2
ac_select = 1
ac_abort = 0
ac_excep = 3
RETURN void
* Here are the sample functions I wrote to operate on the list.
* Select the current item and exit.
FUNCTION sel_func
PARAM cur_elem
RETURN 0 && Exit.
* Delete the current item.
FUNCTION del_func
PARAM cur_elem
* Get around ADEL() anomaly.
IF cur_elem = LEN(sel_list)
sel_list[cur_elem] = .T.
ELSE
ADEL(sel_list, cur_elem)
ENDIF
RETURN 2 && Redraw.
* Insert an element before the current item.
FUNCTION ins_func
PARAM cur_elem
PRIVATE new_list[LEN(sel_list) + 1]
* Insert element into new array.
ACOPY(sel_list, new_list, 1, cur_elem - 1, 1)
new_list[cur_elem] = space(r - l - 1)
ACOPY(sel_list, new_list, cur_elem, LEN(sel_list)-cur_elem + ;
1, cur_elem + 1)
* Redimension sel_list.
PUBLIC sel_list[LEN(new_list)]
* Now copy new list into it.
ACOPY(new_list, sel_list)
RETURN 2 && Redraw.
* Edit the current item.
FUNCTION change_func
PARAM cur_elem
SET CURSOR ON
* We must allow them to GET the width of the box.
sel_list[cur_elem] = SUBSTR(sel_list[cur_elem] + space(r-l-1), ;
1, r - l - 1)
@ t + rel_pos + 1, l + 1 GET sel_list[cur_elem]
READ
sel_list[cur_elem] = trim(sel_list[cur_elem])
SET CURSOR OFF
RETURN 2 && Redraw.
* Exit the process.
FUNCTION ex_func
PARAM cur_elem
RETURN 1 && Abort.
* EOF: TwoMenu2.prg